perm filename DPY[G,BGB] blob
sn#054444 filedate 1973-07-20 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBR(STADPY) STATUS DISPLAY
C00004 00003 ----- STADPY TRANSLATION STRENGTH.
C00006 00004 ----- STADPY DISPLAY THE SCRATCH PAD PDL.
C00008 00005 SUBR(NTYPE,NODE) FETCH NODE TYPE NUMBER 0 TO 17.
C00010 00006 TABLES REL,CONTYP,NNAMES,NLETTER Node Info. Tables
C00012 00007 NODE CONTENT TYPES.
C00013 00008 SUBR(JDPY,NODE) DISPLAY NODE'S NUMERAL.
C00015 00009 SUBR(DPYNODE,NODE) DISPLAY NODE CONTENTS.
C00017 00010 FULL WORD.
C00019 ENDMK
C⊗;
SUBR(STADPY) ;STATUS DISPLAY
COMMENT ⊗------------------------------------------------------------
⊗↔ EXTERN DECDPY,DPYSTR,FDPY,EDPY,VDPY,DTYO,IDPY
EXTERN AIVECT,AVECT,BUFDPY,FLODPY,DPYOUT,DPYSET,DPYBUF
CALL(DPYSET,DPYBUF)
SKIPN FLAGSD↔GO L4 ;STATUS DISPLAY INHIBIT.
YDEL ←← -=45
;STATUS OF FRAME SELECT.
CALL(AIVECT,[=180],[=500+YDEL])
LAC 1,FRAAM
PUSH P,[
[ASCIZ/WORLD/]
[ASCIZ/BODY/]
[ASCIZ/RELATIVE/]
[ASCIZ/CAMERA/]](1)
CALL(DPYSTR)
;STATUS OF FRAME ORIGIN SWITCH.
LACI[ASCIZ/ FRAME/]
SKIPE FRMORG
LACI[ASCIZ/ FRAME */]
CALL(DPYSTR,0)
;STATUS OF OPERAT SELECT SWITCH.
CALL(AIVECT,[=365],[=500+YDEL])
LAC 1,OPERAT
PUSH P,[
[ASCIZ/TRANSLATION/]
[ASCIZ/ROTATION/]
[ASCIZ/DILATION/]
[ASCIZ/REFLECTION/]](1)
CALL(DPYSTR)
;----- STADPY ;TRANSLATION STRENGTH.
CALL(AIVECT,[=185],[=480+YDEL])
CALL(FLODPY,TDEL,[4])
CALL(DPYSTR,{[[ASCIZ/ FEET/]]})
;ROTATION STRENGTH IN PI FRACTION.
CALL(AIVECT,[=185],[=460+YDEL])
L1: LAC RDEL↔LAC 1,[3.15]
CAMLE[6.28]↔GO L2
CAML[2.0]↔GO[FSC 1,1↔PUSH P,1
CALL(DTYO,["2"])↔POP P,1
GO .+1]
FDVR 1,RDEL↔FIX 1,233000↔PUSH P,1
CALL(DPYSTR,{[[ASCIZ"π/"]]})
CALL(DECDPY)
L2:
;ROTATION STRENGTH IN RADIANS.
CALL(AIVECT,[=400],[=460+YDEL])
CALL(FLODPY,RDEL,[3])
;RDEL IN DEGREES, MINUTES AND SECONDS.
CALL(AIVECT,[=270],[=460+YDEL])
LAC 1,RDEL
FMPR 1,[206264.806]
FIX 1,233000
AOS 1
IDIVI 1,=3600
IDIVI 2,=60
PUSH P,3
PUSH P,2
PUSH P,1
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)↔CALL(DTYO,[" "])
CALL(DECDPY)
;DILATION STRENGTH.
CALL(AIVECT,[=390],[=480+YDEL])
LAC DDEL↔FMP[100.0]↔FADR[0.001]
CALL(FLODPY,0,[2])
CALL(DTYO,["%"])
CALL(DTYO,[" "])
LAC AXECNT↔ADDI 60↔CALL(DTYO,0)
;----- STADPY DISPLAY THE SCRATCH PAD PDL.
CALL(AIVECT,[-=511],[=430])
CDR 16,PDLPTR
CAILE 16,PADPDL↔GO[
CALL(IDPY,{(16)})
CALL(NTYPE,{(16)})
CAIN 1,$YNODE↔GO $.+3
CAIG 1,$BODY↔GO NOTFEV
CALL(DPYSTR,[[ASCIZ/ of /]])
CALL(BGET,{(16)})
CALL(IDPY,1)
NOTFEV: CALL(DTYO,[15])↔CALL(DTYO,[12])
SOJA 16,.-1]
SKIPN FLAGL↔GO L3
;DISPLAY TOP OBJECT OF PADPDL.
CDR 16,PDLPTR↔CAILE 16,PADPDL
GO[CALL(DPYTOP,{(16)})↔GO .+1]
;DISPLAY THE SECOND OBJECT WHEN APPROPRIATE.
CDR 16,PDLPTR↔CAILE 16,PADPDL+1
GO[ LAC 1,-1(16)↔LAC 2,(16)
LAC 0,(1)↔IOR 0,(2)↔LDB[POINT 3,0,16]
CAIE 6↔CAIN 3↔SKIPA↔GO .+1
CALL(LINKED,1,2)↔JUMPE 1,.+1
CALL(DPYTOP,{-1(16)})
GO .+1]
L3: CDR 1,PDLPTR↔CAIGE 1,PADPDL+1↔GO L4↔LAC 1,(1)
SKIPE FLAGD↔GO[CALL(DPYNODE,1)↔GO L4]
L4: CALL(DPYOUT,[0])
POP0J
ENDR STADPY;2-FEB-73(BGB)
SUBR(NTYPE,NODE) ;FETCH NODE TYPE NUMBER 0 TO 17.
LAC 1,@NODE ;TYPE BITS WORD.
SKIPGE 1↔SETZ 1, ;NEGATIVE BIT.
TLNE 1,(1B9)↔SETZ 1, ;NORMALIZATION BIT.
ANDI 1,17↔POP1J
ENDR NTYPE;3/25/73(BGB)______________________________________________
SUBR(DPYTOP,OBJECT) ;SPECIAL ENTITY DISPLAY.
CALL(NTYPE,OBJECT)
CAIGE 1,$YNODE↔POP1J
GO @[ POP1J. ;YNODE
POP1J. ;ZNODE
POP1J. ;BODY
FDPY ;FACE
EDPY ;EDGE
VDPY ;VERTEX
]-$YNODE(1)
ENDR DPYTOP;---------------------------------------------------------
;TABLES REL,CONTYP,NNAMES,NLETTER ;Node Info. Tables
;NODE RELLOCATION BITS.
; 0 1 2| 3 4 5| 6 7 8| 9 10 11|12 13 14|15 16 17| ← BIT.
; 0 0 0| 0 0 0| 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
;
INTERNAL REL
REL: XWD 0000, 0000 ;FRAME.
XWD 0000, 0001 ;EMPTY.
XWD 0000, 0202 ;UNIVERSE.
XWD 0000, 0000 ;LAMP.
XWD 0600, 1600 ;CAMERA.
XWD 2640, 3660 ;WORLD.
XWD 1600, 1600 ;WINDOW.
XWD 0760, 0760 ;IMAGE.
XWD 0004, 0004 ;TEXT.
XWD 0000, 0000 ;XNODE.
XWD 0000, 0000 ;YNODE.
XWD 0000, 0000 ;ZNODE.
XWD 3760, 3760 ;BODY.
XWD 1020, 1060 ;FACE.
XWD 3760, 3760 ;EDGE.
XWD 0140, 0140 ;VERTEX.
;NODE CONTENT TYPES.
COMMENT ⊗
0 -- EMPTY.
1 -- OCTAL WORD.
2 -- ASCII.
3 -- REAL.
4 -- NODE.
| 8 7 6| 5 4 3| 2 1 0|-1 -2 -3| ← WORD.
⊗
CONTYP:
BYTE(9)333,333,333,333 ;FRAME.
BYTE(9)000,000,000,000 ;EMPTY.
BYTE(9)000,040,001,000 ;UNIVERSE.
BYTE(9)000,000,001,000 ;LAMP.
0 ;CAMERA.
0 ;WORLD.
0 ;WINDOW.
0 ;IMAGE.
BYTE(9)000,000,001,000 ;TEXT.
0 ;XNODE.
0 ;YNODE.
0 ;ZNODE.
BYTE(9)044,444,441,220 ;BODY.
BYTE(9)004,113,041,333 ;FACE.
BYTE(9)044,444,441,000 ;EDGE.
BYTE(9)003,334,411,333 ;VERTEX.
SUBR(JDPY,NODE) ;DISPLAY NODE'S NUMERAL.
SKIPN 1,NODE↔GO[
CALL(DPYSTR,{[[ASCIZ/NIL/]]})↔POP1J]
CAMGE 1,UNIVERSE↔GO L
CAML 1,44↔GO L
CALL(NTYPE,1)
CALL(DTYO,{NLETTER(1)})
L: CALL({OCTDPY+1},NODE)
POP1J
ENDR JDPY;3/25/73(BGB)-----------------------------------------------
;NODE NAMES.
INTERN NNAMES
NNAMES:
[ASCIZ"FRAME"]↔[ASCIZ"EMPTY"]↔[ASCIZ"UNIVERSE"]↔[ASCIZ"LAMP"]
[ASCIZ"CAMERA"]↔[ASCIZ"WORLD"]↔[ASCIZ"WINDOW"]↔[ASCIZ"IMAGE"]
[ASCIZ"TEXT"]↔[ASCIZ"XNODE"]↔[ASCIZ"YNODE"]↔[ASCIZ"ZNODE"]
[ASCIZ"BODY"]↔[ASCIZ"FACE"]↔[ASCIZ"EDGE"]↔[ASCIZ"VERTEX"]
;NODE INITIALS.
INTERN NLETTER
NLETTER:
"R" ↔ "M" ↔ "U" ↔ "L"
"C" ↔ "W" ↔ "D" ↔ "I"
"T" ↔ "X" ↔ "Y" ↔ "Z"
"B" ↔ "F" ↔ "E" ↔ "V"
SUBR(DPYNODE,NODE) ;DISPLAY NODE CONTENTS.
;--------------------------------------------------------------------
EXTERN AIVECT,AVECT,DPYBIG
EXTERN DTYO,IDPY,DPYSTR,FLODPY,DECDPY,OCTDPY
;BOX IN LOWER RIGHT HAND CORNER OF THE SCREEN
CALL(AIVECT,[=260],[-=70])
CALL(AVECT,[=260],[-=380])
CALL(AVECT,[=508],[-=380])
CALL(AVECT,[=508],[-=70])
CALL(AVECT,[=260],[-=70])
CALL(DPYBIG,[1])
CALL(JDPY,NODE)
CALL(DPYSTR,{[[ASCIZ" "]]})
SETQ(KIND,{NTYPE,NODE})
LAC [POINT 7,LNKCHR]↔DAC LNKPTR
CAIN 1,$YNODE
GO [ LAC 2,NODE↔LAC 0,YREL(2)↔GO .+2 ] ;YNODES
LAC REL(1)↔DAC RELTMP ;RELLOCATION.
LAC CONTYP(1)↔DAC CONTMP ;CONTENT TYPE.
LAC NNAMES(1)↔CALL(DPYSTR,0)
NIM -3↔DAC WRD
L1:
LACN WRD↔IMULI =25↔SUBI =170↔DAC Y
CALL(AIVECT,[=265],Y)
ILDB 1,LNKPTR ;PICK UP LINK CHARACTERS (LEFT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BETWEEN THEM
ILDB 1,LNKPTR ;(RIGHT HALF)
CALL(DTYO,1)
CALL(DTYO,[" "]) ;A SPACE BEFORE A NUMBER
SKIPGE WRD↔GO .+3↔CALL(DTYO,[" "]) ;AND ANOTHER IF NOT NEGATIVE
CALL(DECDPY,WRD)
;FULL WORD.
CALL(AIVECT,[=345],Y)
LACN 2,WRD↔LAC CONTMP
ROT(2)↔ROT(2)↔ROT(2)↔ANDI 7000
CAIN 3000↔GO[LAC 1,NODE↔ADD 1,WRD
CALL(FLODPY,{(1)},[4])↔GO L2]
;LEFT HALF.
CALL(AIVECT,[=345],Y)
LAC 1,NODE↔ADD 1,WRD↔CAR(1)↔PUSH P,0
LACN 2,WRD↔CAR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY+1})
;RIGHT HALF.
CALL(AIVECT,[=425],Y)
LAC 1,NODE↔ADD 1,WRD↔CDR(1)↔PUSH P,0
LACN 2,WRD↔CDR RELTMP↔ROT(2)
TRNE 10↔GO[CALL(JDPY)↔GO .+2]↔CALL({OCTDPY+1})
L2: AOS 1,WRD↔CAIG 1,8↔GO L1
CALL(DPYBIG,[2])
POP1J
LNKCHR: ASCIZ/ <>≤≥∨∧∩∪⊂⊃←→.,/
DECLARE{WRD,X,Y,KIND,RELTMP,CONTMP,LNKPTR}
ENDR DPYNODE;3/25/73(BGB)--------------------------------------------
SUBR(SEENODE,NODE)
PUSHACS
CALL(DPYSET,[DPYBUF])
CALL(DPYNODE,NODE)
CALL(DPYOUT,[0])
POPACS
POP1J
ENDR SEENODE;5/4/73(TVR)---------------------------------------------